Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/tbbs/prgsourc.zip/MSGMGR.ZIP/MSG_SHOW.PRG

Text File | 1996-03-07 | 16KB | 580 lines

* e = end of message array
* m
* z
* l = line read
* f
* i
* g = Goto number
* ms = message number
* ok = Acc return
SET TYPEAHEAD TO 5
SET ESCAPE OFF
SET FORMAT TO fscr NOCLEAR
SET INTENSITY OFF

FOPEN m msg.cfg 10 512
FLREAD m f l
FCLOSE m

l = CRTrim(RTrim(l))
f = SubStr(l,8,1) + ":\flags\flags.dbf"
i = SubStr(l,8,1) + ":\flags\user.ndx"

IF File(f) .AND. File(i)
   USE (f) INDEX (i)
   SEEK UName()
   IF .NOT. Found()
      f = Replicate(".",96)
   ELSE
      f = flg
   ENDIF
   CLOSE DATABASES
ELSE
  f = Replicate(".",96)
ENDIF

ok = .T.
g = 0

USE msgs INDEX numb,mess
COUNT TO e
GOTO TOP

DECLARE msg[e]

ms = 1
DO WHILE ms < e
   msg[ms] = title
   ms = ms + 1
   SKIP
ENDDO
msg[ms] = title
SET ORDER TO 2

IF SubStr(l,1,5) = Chr(240)+Chr(165)+Chr(129)+Chr(156)+Chr(146)
   t = .T.
ELSE
   t = .F.
ENDIF

DO Scr

tPag = Ceiling(e/17)                   && Total pages
ms = 1                                   && Current Message
pag = 1                                  && Current page
r = 3                                  && Current r


DO Lst WITH 0

SET COLOR TO GR+/R
@ r,8 SAY msg[ms]

SET COLOR TO N/N
k = " "
@ 2,0 GET k
DO WHILE .T.
   READ
   DO CASE
      CASE LastKey() = 3                         && <Page Down>
           IF ms = e
              LOOP
           ENDIF
           IF pag = tPag
              SET COLOR TO W+/N
              @ r,8 SAY msg[ms]
              r = r + (e - ms)
              ms = e
              SET COLOR TO GR+/R
              @ r,8 SAY msg[ms]
              LOOP
           ELSE
              IF (ms + 17) > e
                 r = r - ((ms + 17) - e)
                 ms = e
              ELSE
                 ms = ms + 17
              ENDIF
              pag = pag + 1
           ENDIF

      CASE LastKey() = 5                         && Up Arrow
           IF ms = 1
              LOOP
           ENDIF
           IF r = 3
              ms = ms - 1
              pag = pag - 1
              r = 19
           ELSE
              SET COLOR TO W+/N
              @ r,8 SAY msg[ms]
              r = r - 1
              ms = ms - 1
              SET COLOR TO GR+/R
              @ r,8 SAY msg[ms]
              LOOP
           ENDIF

      CASE LastKey() = 18                        && <Page Up>
           IF ms = 1
              LOOP
           ENDIF
           IF pag = 1
              SET COLOR TO W+/N
              @ r,8 SAY msg[ms]
              r = r - (ms - 1)
              ms = 1
              SET COLOR TO GR+/R
              @ r,8 SAY msg[ms]
              LOOP
           ELSE
              ms = ms - 17
              pag = pag - 1
           ENDIF

      CASE LastKey() = 24                        && Down Arrow
           IF ms = e
              LOOP
           ENDIF
           IF r = 19
              ms = ms + 1
              pag = pag + 1
              r = 3
           ELSE
              SET COLOR TO W+/N
              @ r,8 SAY msg[ms]
              r = r + 1
              ms = ms + 1
              SET COLOR TO GR+/R
              @ r,8 SAY msg[ms]
              LOOP
           ENDIF

      CASE LastKey() = 27                   && <Esc>
           QUIT

      CASE LastKey() = 13                          && <Enter>
           DO Acc
           IF .NOT. ok
              ok = .T.
              LOOP
           ENDIF
           DO CASE
              CASE btype = "F"             && Combined Read of Bi-Level Brds
                   p = RTrim(board) + RTrim(path) + " /F"
              CASE btype = "S"             && Read Standard Brd
                   p = RTrim(board)
              CASE btype = "I"             && Isolated Read of Topic Brds
                   p = RTrim(board) + RTrim(path) + " /S"
              CASE btype = "C"             && Combined Read of Standard Brds
                   p = "X"
                   DOTBBS TYPE 6 OPTDATA " "
              CASE btype = "O"             && Ordered Combined Read
                   p = "/O"
              CASE btype = "X"             && Waiting Messages
                   p = "X"
                   DOTBBS TYPE 15 OPTDATA " "
           ENDCASE
           IF p # "X"
              DOTBBS TYPE 6 OPTDATA p
           ENDIF
           USE msgs INDEX mess
           DO Scr

      CASE LastKey() = 63                       && Help
           h = HomePath() + "MSG.HLP"
           DOTBBS TYPE 1 OPTDATA h
           USE msgs INDEX mess
           DO Scr

      CASE LastKey() = 68 .OR. LastKey() = 100      && Delete
           IF SubStr(l,9,1) # "D"
              LOOP
           ENDIF
           DO Acc
           IF .NOT. ok
              ok = .T.
              LOOP
           ENDIF
           DO CASE
              CASE btype = "F"               && Comb. Delete of Bi-Level Brds
                   p = RTrim(board) + RTrim(path) + " /F"
              CASE btype = "X"                 && Waiting Msgs.
                   SET COLOR TO B/B
                   @ 7,29 CLEAR TO 12,50
                   SET COLOR TO W+/B
                   @ 8,31 SAY "Cannot Delete."
                   @ 9,31 SAY "Not your messages."
                   @ 11,34 SAY   "<ANY KEY>"
                   k = InKey(20)
                   p = "X"
              CASE btype = "S"             && Delete from Standard Brd
                   p = RTrim(board)
              CASE btype = "I"                && Delete from Topic Board
                   p = RTrim(board) + RTrim(path) + " /S"
              CASE btype = "C"             && Comb. Delete of Standard Brds
                   p = "X"
                   DOTBBS TYPE 9 OPTDATA " "
                   USE msgs INDEX mess
              CASE btype = "O"             && Ordered Comb. Delete
                   p = "/O"
           ENDCASE
           IF p # "X"
              DOTBBS TYPE 9 OPTDATA p
              USE msgs INDEX mess
           ENDIF
           DO Scr

      CASE LastKey() = 70 .OR. LastKey() = 102      && Find
           DO BFind WITH g
           IF g # 0 .AND. g <= e
              pag = Ceiling(g/17)
              ms = g
              r = ms - ((pag*17)-17) + 2
           ENDIF
           DO Scr

      CASE LastKey() = 71 .OR. LastKey() = 103      && Goto
           SET COLOR TO W+/B
           g = 0
           @ 8,29 CLEAR TO 10,49
           @ 9,31 SAY "Msg. Board# "
           @ 9,43 GET g PICTURE "@BZ 999"
           READ
           DO CASE
              CASE g = 0
                   @ 9,31 SAY "Cancelling Go To"
                   k = Inkey(1)
              CASE g # 0 .AND. g <= e
                   pag = Ceiling(g/17)
                   ms = g
                   r = ms - ((pag*17)-17) + 2
              CASE g > e
                   @ 9,31 SAY "Last board# is " + LTrim(Str(e))
                   k = Inkey(1)
           ENDCASE

      CASE LastKey() = 74 .OR. LastKey() = 106      && Join
           SET COLOR TO W+/N
           @ 0,0 CLEAR
           IF SubStr(l,11) = "S"
              DOTBBS TYPE 24 OPTDATA " "
           ELSE
              DOTBBS TYPE 24 OPTDATA SubStr(l,11)
           ENDIF
           USE msgs INDEX mess
           DO Scr

      CASE LastKey() = 82 .OR. LastKey() = 114      && Reset Messages
           DO Acc
           IF .NOT. ok
              ok = .T.
              LOOP
           ENDIF
           DO CASE
              CASE btype = "F"             && Comb. Bi-Level Brds
                   p = RTrim(board) + RTrim(path) + " /F"
              CASE btype = "X"
                   SET COLOR TO B/B
                   @ 7,24 CLEAR TO 11,54
                   SET COLOR TO W+/B
                   @ 8,26 SAY "Cannot Reset on this Board."
                   @ 10,33 SAY       "<ANY KEY>"
                   k = InKey(20)
                   p = "X"
              CASE btype = "S"             && Standard Brd
                   p = RTrim(board)
              CASE btype = "I"             && Topic Board
                   p = RTrim(board) + RTrim(path) + " /S"
              CASE btype = "C" .OR. btype = "O"      && Comb. Standard
                   p = "X"
                   DOTBBS TYPE 16 OPTDATA " "
                   USE msgs INDEX mess
           ENDCASE
           IF p # "X"
              DOTBBS TYPE 16 OPTDATA p
              USE msgs INDEX mess
           ENDIF
           DO Scr

      CASE LastKey() = 83 .OR. LastKey() = 115      && Scan
           DO Acc
           IF .NOT. ok
              ok = .T.
              LOOP
           ENDIF
           DO CASE
              CASE btype = "F"             && Comb. Scan of Bi-Level Brds
                   p = RTrim(board) + RTrim(path) + " /F"
              CASE btype = "S"             && Scan Standard Brd
                   p = RTrim(board)
              CASE btype = "I"             && Isolated Scan of Topic Brds
                   p = RTrim(board) + RTrim(path) + " /S"
              CASE btype = "C"             && Comb. Scan of Standard Brds
                   p = "X"
                   DOTBBS TYPE 6 OPTDATA " "
              CASE btype = "O"             && Ordered Combined Scan
                   p = "/O"
              CASE btype = "X"             && Waiting Messages
                   p = "X"
                   DOTBBS TYPE 15 OPTDATA " "
           ENDCASE
           IF p # "X"
              DOTBBS TYPE 8 OPTDATA p
           ENDIF
           USE msgs INDEX mess
           DO Scr

      CASE LastKey() = 87 .OR. LastKey() = 119      && Write
           DO Acc
           IF .NOT. ok
              ok = .T.
              LOOP
           ENDIF
           DO CASE
              CASE btype = "F" .OR. btype = "X"
                   SET COLOR TO B/B
                   @ 7,24 CLEAR TO 11,54
                   SET COLOR TO W+/B
                   @ 8,26 SAY "Cannot Write to this Board."
                   @ 10,33 SAY       "<ANY KEY>"
                   k = InKey(20)
                   p = "X"
              CASE btype = "S"             && Write to Standard Brd
                   p = RTrim(board)
              CASE btype = "I"             && Write to Topic Board
                   p = RTrim(board) + RTrim(path) + " /S"
              CASE btype = "C" .OR. btype = "O"      && Combined Write
                   p = "X"
                   DOTBBS TYPE 7 OPTDATA " "
                   USE msgs INDEX mess
           ENDCASE
           IF p # "X"
              DOTBBS TYPE 7 OPTDATA (p)
              USE msgs INDEX mess
           ENDIF
           DO Scr
      OTHERWISE
           LOOP
   ENDCASE
   DO Lst WITH 0
   SET COLOR TO GR+/R
   @ r,8 SAY msg[ms]
ENDDO
QUIT

**************************************************
PROCEDURE Scr

SET COLOR TO N/N
@ 0,0 CLEAR
SET COLOR TO B/B
@ 0,0 CLEAR TO 1,79
@ 21,0 CLEAR TO 23,79
SET COLOR TO B+/B
IF t
   @ 0,55 SAY "Message Manager r1.0"
ELSE
   @ 0,47 SAY "Message Manager s1.0  60-Day"
   @ 1,47 SAY "(c) 1996 LocalNet     SHAREWARE"
ENDIF
SET COLOR TO GR+/B
@ 0,3 SAY "Message Boards/Conferences"
@ 21,2 SAY "<Enter>"
@ 22,8 SAY "W"
IF SubStr(l,9,1) = "D"
   @ 23,8 SAY "D"
ENDIF
@ 21,31 SAY "S"
@ 22,31 SAY "R"
@ 23,31 SAY "J"
@ 21,56 SAY "F"
@ 22,56 SAY "G"
@ 23,56 SAY "?"
@ 23,67 SAY "<Esc>"
SET COLOR TO W+/B
@ 21,10 SAY "= Read msgs."
IF SubStr(l,10,1) = "U"
   @ 22,10 SAY "= Write/Upload msg."
ELSE
   @ 22,10 SAY "= Write message"
ENDIF
IF SubStr(l,9,1) = "D"
   @ 23,10 SAY "= Delete your msgs."
ENDIF
@ 21,33 SAY "= Scan msgs."
@ 22,33 SAY "= Reset msgs. read"
@ 23,33 SAY "= Join(add) topic"
@ 21,58 SAY "= Find Msg. Board"
@ 22,58 SAY "= Go to Msg. Board#"
@ 23,58 SAY "= Help"
@ 23,73 SAY "= Quit"
RETURN

**************************************************
PROCEDURE Lst
PARAMETERS a

PRIVATE r
r = 3
IF a = 0
   n = Int((pag-1)*17) + 1
ELSE
   n = 1 + (a-1)*17
ENDIF

SET COLOR TO N/N
@ 2,0 CLEAR TO 20,79
DO WHILE r <= 19
         IF a = 0
            SEEK msg[n]
         ELSE
            SEEK b[n]
         ENDIF
         SET COLOR TO GR+/N
         @ r,1 SAY "["
         @ r,2 SAY num PICTURE "@Z 999"
         @ r,5 SAY "]"
         SET COLOR TO W+/N
         @ r,8 SAY title
         SET COLOR TO GR+/N
         @ r,26 SAY desc
         SET COLOR TO W+/N
         @ r,53 SAY srce
         DO CASE
            CASE flag = "O"
                 SET COLOR TO G+/N
                 @ r,63 SAY "Open      "
            CASE flag = "F"
                 SET COLOR TO R+/N
                 @ r,63 SAY "Restricted"
            CASE flag = "R"
                 SET COLOR TO GR+/N
                 @ r,63 SAY "Read Only "
            CASE flag = "W"
                 SET COLOR TO GR+/N
                 @ r,63 SAY "Write Only "
            CASE flag = "T"
                 SET COLOR TO GR+/N
                 @ r,63 SAY "Write-Restricted"
         ENDCASE
      IF a = 0 .AND. n = e
         RETURN
      ENDIF
      IF a # 0
         IF n = j
            a = 0
            RETURN
         ENDIF
      ENDIF
      r = r + 1
      n = n + 1
ENDDO
a = a + 1
RETURN

**************************************************
PROCEDURE Acc

SEEK msg[ms]
     IF flag = "F"
        IF fval # SubStr(f,fpos,Len(fval))
           SET COLOR TO B/B
           @ 7,31 CLEAR TO 11,48
           SET COLOR TO W+/B
           @ 8,33 SAY "Access Denied."
           @ 10,35 SAY  "<ANY KEY>"
           k = InKey(20)
           DO Lst WITH 0
           SET COLOR TO GR+/R
           @ r,8 SAY msg[ms]
           ok = .F.
           RETURN
        ENDIF
     ENDIF
SET COLOR TO W+/N
@ 0,0 CLEAR
RETURN

**************************************************
PROCEDURE BFind
PARAMETERS g

STORE Space(16) TO txt
SET COLOR TO W+/B
@ 8,25 CLEAR TO 10,54
@ 9,27 SAY "Subject: "
@ 9,36 GET txt
READ
txt = RTrim(txt)

SET COLOR TO W+/N
@ 0,0 CLEAR

GOTO TOP
COUNT TO j FOR Upper(txt) $ Upper(title) .OR. Upper(txt) $ Upper(desc)

IF j = 0
   @ 2,1 SAY "No Message Board titles or descriptions contain"
   @ 3,1 SAY "the specified text:"
   @ 3,22 SAY Chr(34) + txt + Chr(34)
   k = InKey(40)
   g = 0
   RETURN
ENDIF

DECLARE b[j]

GOTO TOP
j = 0
x = 1
DO WHILE .T.
   IF Upper(txt) $ Upper(title) .OR. Upper(txt) $ Upper(desc)
      j = j + 1
      b[j] = title
   ENDIF
   IF x = e
      EXIT
   ENDIF
   x = x + 1
   SKIP
ENDDO

@ 1,8 SAY "Title             Description                Source    Access"
@ 2,4 TO 2,75
a = 1
DO Lst WITH a
DO WHILE a # 0
   SET COLOR TO RB+/N
   @ 21,5 SAY "< >             < >"
   SET COLOR TO GR+/N
   @ 21,6 SAY "C"
   @ 21,22 SAY "S"
   SET COLOR TO BG+/N
   @ 21,9 SAY "Continue"
   @ 21,25 SAY "Stop Listing"
   k = " "
   @ 21,37 GET k
   DO WHILE .T.
      READ
      DO CASE
         CASE LastKey() = 67 .OR. LastKey() = 99      && Continue
              @ 3,0 CLEAR TO 23,79
              DO Lst WITH a
              EXIT
         CASE LastKey() = 83 .OR. LastKey() = 115     && Stop
              a = 0
              EXIT
      ENDCASE
   ENDDO
ENDDO
g = 0
SET COLOR TO W+/N
@ 21,0 CLEAR TO 21,79
@ 21,1 SAY "Select number to Go To, 0 for none >"
@ 21,37 GET g PICTURE "@BZ 999"
READ
RETURN